home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tools / instcopy.tcl < prev    next >
Encoding:
Text File  |  1993-11-19  |  3.4 KB  |  116 lines
  1. #
  2. # instcopy.tcl -- 
  3. #
  4. # Tcl program to copy files during the installation of Tcl.  This is used
  5. # because "copy -r" is not ubiquitous.  It also adds some minor additional
  6. # functionallity.
  7. #
  8. #------------------------------------------------------------------------------
  9. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  10. #
  11. # Permission to use, copy, modify, and distribute this software and its
  12. # documentation for any purpose and without fee is hereby granted, provided
  13. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  14. # Mark Diekhans make no representations about the suitability of this
  15. # software for any purpose.  It is provided "as is" without express or
  16. # implied warranty.
  17. #------------------------------------------------------------------------------
  18. # $Id: instcopy.tcl,v 3.0 1993/11/19 07:00:03 markd Rel $
  19. #------------------------------------------------------------------------------
  20. #
  21. # It is run in the following manner:
  22. #
  23. #  instcopy file1 file2 ... targetdir
  24. #  instcopy -dirname file1 targetdir
  25. #
  26. #  o -dirname - If specified, then a directory is copies as the target
  27. #     directory rather than to it.
  28. #  o files - List of files to copy. If one of directories are specified, they
  29. #    are copied.
  30. #  o targetdir - Target directory to copy the files to.  If the directory does
  31. #    not exist, it is created (including parent directories).
  32. #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  33.  
  34. #------------------------------------------------------------------------------
  35. # Usage --
  36. #
  37. #   Issue a usage message and exit.
  38. #------------------------------------------------------------------------------
  39. proc Usage {{msg {}}} {
  40.     if {"$msg" != ""} {
  41.         puts stderr "Error: $msg"
  42.     }
  43.     puts stderr {usage: instcopy ?-dirname? file1 file2 ... targetdir}
  44.     exit 1
  45. }
  46.  
  47. #------------------------------------------------------------------------------
  48. # DoACopy --
  49. #
  50. # 
  51. #------------------------------------------------------------------------------
  52.  
  53. proc DoACopy {file targetDir} {
  54.     global dirNameMode
  55.  
  56.     if [file isdirectory $file] {
  57.         if $dirNameMode {
  58.             set target $targetDir
  59.         } else {
  60.             set target $targetDir/[file tail $file]
  61.         }
  62.         puts stdout ""
  63.         puts stdout "Copying directory hierarchy $file to $target"
  64.         puts stdout ""
  65.         if ![file exists $target] {
  66.             mkdir -path  $target
  67.         }
  68.         CopyDir $file $target
  69.     } else {
  70.         puts stdout ""
  71.         puts stdout "Copying $file to $targetDir"
  72.         puts stdout ""
  73.         CopyFile $file $targetDir
  74.     }
  75. }
  76.  
  77.  
  78. #------------------------------------------------------------------------------
  79. # Main program code.
  80. #------------------------------------------------------------------------------
  81.  
  82. #
  83. # Parse the arguments
  84. #
  85. if {$argc < 2} {
  86.     Usage "Not enough arguments"
  87. }
  88.  
  89. set dirNameMode 0
  90. if {[lindex $argv 0] == "-dirname"} {
  91.     lvarpop argv
  92.     incr argc -1
  93.     set dirNameMode 1
  94. }
  95.  
  96. set files [lrange $argv 0 [expr $argc-2]]
  97. set targetDir [lindex $argv [expr $argc-1]]
  98.  
  99. if {[file exists $targetDir] && ![file isdirectory $targetDir]} {
  100.    Usage "Target is not a directory: $targetDir"
  101. }
  102.  
  103. umask 022
  104.  
  105. if [catch {
  106.     if ![file exists $targetDir] {
  107.         mkdir -path $targetDir
  108.     }
  109.     foreach file $files {
  110.         DoACopy $file $targetDir
  111.     }
  112. } msg] {
  113.     puts stderr "Error: $msg"
  114.     exit 1
  115. }
  116.